Kod
rm(list = ls())
library(tidyverse)
library(chron)
library(corrplot)
library(fuzzyjoin)
library(DT)
df = read.csv("data.csv")
# datatable(df)
datatable(head(df, n = 40))Badanie opóźnień w ruchu pociągów
Wstęp
Zarys projektu
W tym projekcie po czyszczeniu zbioru danych oraz konwertowaniu poszczególnych zmiennych do właściwego dla nas typu zajmiemy się badaniem zależności pomiędzy pewnymi typami zmiennych za pomocą np. wyznaczenia korelacji pomiędzy zmiennymi numerycznymi. Znajdziemy też średnie opóźnień dla poszczególnych przewoźników lub relacji, uwzględnimy dane pogodowe, żeby wyłapać tę zależność oraz wesprzymy nasze wnioski odpowiednimi wizualicjami. Pomysłem też jest zrobienie liniowego modelu predykcyjnego, który na podstawie danych pogodowych będzie przewidywał średnie opóźnienie na poszczególnych stacji
Cele
Celem projektu jest zbadać częstotliwość oraz skalę opóźnień pociągów w danym okresie oraz zależność ich od sytuacji meteorologicznej. Przedstawić tę zależność za pomocą wizualizacji. Zwizualizować też inne zależności w danych
Hipotezy
Przed badaniem robimy przypuszczenie, iż gorsza sytuacja pogodowa powoduje większe i częstsze opóźnienia
Zbiory danych
Opis: The dataset contains information about delays on polish railroads published by the Polish State Railways in real time. Data was scraped from https://infopasazer.intercity.pl. It covers the period from the midnight of 2022-05-16 until the midnight of 2022-05-30. Observations were collected every 5 minutes.
Zmienne wyglądają w taki sposób po drobnych zmianach:
datetime - czas w którym dane zostały zeskrapowane
id - numer pociągu
carrier - przewoźnik
start - stacja początkowa
end - stacja końcowa
delay - current estimated delay
name - train station name
Dataset został opublikowany w roku 2022 i do teraz ma nie więcej niż 800 pobrań. Nie znalazłem również żadnych raportów z wykorzystaniem tego zbioru, więc można stwierdzić, że zbiór jest dość unikatowy.
Z drugiej strony, zbiór liczy około 4 mln obserwacji, więc jest dla nas dość reprezentatywne.
Opis: Są to archiwowe dane pogodowe dla okresu, odpowiadającego okresu zbierania danych w pierwszym zbiorze. Za lokalizaję wzięto przybliżone koordynaty geograficznego centrum Polski.
Przygotowanie zbiorów danych
Z powodu tego, że zbiór 1 liczy prawie 4 mln obserwacji, wybranie prób reprezentatywnych oraz łączenie w jedyny zbiór znalazły się w oddzielnym pliku
Kod
df = df[, !colnames(df)=="X"]
df[sapply(df, is.character)] = lapply(df[sapply(df, is.character)], as.factor)Analiza zależności
Badanie korelacji zmiennych numerycznych
Zbadajmy korelację pomiędzy zmienną delay a zmiennymi odpowiadającymi warunkom pogodowym
Kod
library(ggcorrplot)
corr = cor(select_if(df, is.numeric)[,-1])
ggcorrplot(corr,
method = "circle",
type = "upper",
ggtheme = theme_classic,
legend.title = "",
colors = c("purple", "white", "darkgreen"),
outline.color = "black")
Na zaskoczenie korelacja pomiędzy zmienną delay a zmiennymi pogodowymi okazała się bardzo bliska zeru, z czego robimy wniosek, że w ten sposób nie ujawnimy zależności o ile one istnieją
Model regresji logistycznej
Model ten jest przydatny do przeprowadzenia przewidywania zmiennej typu logicznego na podstawie wartości predyktorów. Naszą zmienną którą będziemy chcieli przewidywać będzie is_late. Model będziemy uczyć na zbiorze testowym na podstawie predyktorów rain, wind_speed oraz temperature. Jako wynik model będzie zwracał prawdopodobieństwo tego, że w danym przypadku wystąpi opóźnienie (delay > 5), czyli że is_late = TRUE
Kod
library(caret)
df$is_late = ifelse(df$delay>=5, TRUE, FALSE)
sample = sample(c(TRUE, FALSE), nrow(df), replace = TRUE, prob=c(0.7,0.3))
train = df[sample, ]
test = df[!sample, ]
rm(sample)
model = glm(is_late ~ rain, family="binomial", data=train)
predicted = predict(model, test[, colnames(test)!="is_late"], type="response")
predicted_bool = ifelse(predicted>0.1, TRUE, FALSE)
confusionMatrix(factor(test$is_late, levels = c(TRUE, FALSE)), factor(predicted_bool, levels = c(TRUE, FALSE)))Confusion Matrix and Statistics
Reference
Prediction TRUE FALSE
TRUE 94 5334
FALSE 1314 53804
Accuracy : 0.8902
95% CI : (0.8877, 0.8927)
No Information Rate : 0.9767
P-Value [Acc > NIR] : 1
Kappa : -0.0098
Mcnemar's Test P-Value : <2e-16
Sensitivity : 0.066761
Specificity : 0.909804
Pos Pred Value : 0.017318
Neg Pred Value : 0.976160
Prevalence : 0.023255
Detection Rate : 0.001553
Detection Prevalence : 0.089651
Balanced Accuracy : 0.488283
'Positive' Class : TRUE
Widzimy, że model nie ma mocy przewidywania, ponieważ p-value jest równe 1 oraz na przykładzie danych testowych możemy się upewnić, że model nie jest skuteczny w przewidywaniu naszej zmiennej. Stało się tak dlatego, że w naszych danych nie występuje wystarczającej dla nas zależności zmiennej którą przewidujemy od predyktorów a więc nie możemy sądzić o tej zmiennej na podstawie innych
Wizualizacje
Dane meteorologiczne
Aby zilustrować jaką sytuację mamy co do zależności opóźnienia, zwizualizujmy jakie opóźnienia były przy różnych ilościach opadów
Kod
ggplot(df)+
geom_point(aes(y = delay, x = rain), colour = "darkorange")+
xlab("Opady (mm)")+
ylab("Opóźnienie (min)")+
theme_minimal() 
Nie jest to dziwne więc że korelacja była taka mała a model regresji okazał się nie efektywny. Widzimy z wykresu, że w naszych danych nie ma odpowiedniości: duże jak i małe opóźnienia można spotkać przy dużych, jak i przy małych opadach.
Kod
df$is_rain = ifelse(df$rain>0, TRUE, FALSE)
ggplot(df) +
geom_boxplot(aes(is_rain, log(delay), fill = is_rain)) +
theme_minimal() +
xlab("Opady")+
ylab("Opóźnienie (min | log scale)")+
theme(
axis.title = element_text(face = "bold"),
legend.position = "none"
)
Widać że obserwacje przy deszczu i bez niego są niemal identyczne względem opóźnienia
Przewoźnicy
Kod
library(plotly)
df$delay_factor = cut(df$delay,
breaks = c(-Inf, 0, 5, 30, 60, Inf),
labels = c("0 min", "1-5 min", "6-30 min", "31-60 min", "> 60 min"),
right = TRUE)
delay_summary = df %>%
group_by(carrier, delay_factor) %>%
summarise(count = n(), .groups = 'drop')
total_counts = delay_summary %>%
group_by(carrier) %>%
summarise(total_count = sum(count), .groups = 'drop')
delay_summary = delay_summary %>%
left_join(total_counts, by = "carrier") %>%
mutate(count = 100*count / total_count)
ggplot(delay_summary, aes(y = carrier, x = count, fill = delay_factor)) +
geom_bar(stat = "identity") +
labs(
title = "Odsetek opóźnień różnych stopni",
fill = ""
) +
xlab("") +
ylab("") +
theme_minimal(base_size = 15) +
guides(fill = guide_legend(nrow = 2))+
theme(
legend.position = "bottom",
plot.title = element_text(hjust = 0.5, face = "bold"),
axis.text.y = element_text(face = "bold"),
legend.text = element_text(size = 10, face = "bold"),
legend.byrow = TRUE,
legend.margin = margin(t = 0, b = 0, r = 0, l = 0)
)
Widzimy, że każdy przewoźnik ma trend do tego, że tych większych opóźnień ma mniej niż mniejszych, przy czym znacznie więcej relacji wykonał z opóźnieniem <5 min, jednak warto zauważyć, że na przykład PKP IC ma tą różnicę najmniej widoczną
Kod
df$day = as.POSIXlt(df$datetime)$mday
avg_by_day_carr = df%>%
group_by(day, carrier) %>%
summarise(avg = mean(delay))
avg_by_day_carr %>%
ggplot(aes(x = factor(day), fill = carrier, y = avg)) +
geom_bar(position = 'dodge', stat = "identity") +
theme_minimal() +
ylab("Średnie opóźnienie (min)") +
xlab("Dzień maja 2022")+
guides(fill = guide_legend(ncol = 1))+
ggtitle("Rozkład opóźnień u przewoźników każdego dnia")+
theme(plot.title = element_text(hjust = 0.5, face = "bold"), legend.position = "right", legend.text = element_text(size = 6), legend.title = element_blank(), legend.key.width = unit(0.5, "line"), legend.margin = margin()) 
Widzimy, że w każdym dniu (za wyjątkiem 16 i 19) najbardziej się spóźniał PKP IC. Natomiast Koleje Dolnośląskie Mazowieckie i Śląskie w kulku dniach nie za bardzo odstawały od PKP IC. Prawdopodobnie związane to jest z tym, że przewoźnicy ci działają w obrębie olbrzymich miast i metropolii: Warszawy, Wrocławia i Górnośląsko-Zagłębiowskiej Metropolii, mających skomplikowany system kolejowy, wraźliwy na zakłócenia ruchu.
Kod
ggplot(df)+
geom_violin(aes(x = carrier, y = log(delay), fill = carrier))+
xlab("")+
ylab("Czas opóźnienia (min)") +
ggtitle("Rozkład opóźnień")+
theme_minimal()+
theme(plot.title = element_text(hjust = 0.5, face = "bold"), legend.position = "right", legend.text = element_text(size = 8), legend.title = element_blank(), legend.key.height = unit(1, "line"), legend.key.width = unit(0.3, "line"), legend.margin = margin(), axis.text.x = element_blank()) +
geom_hline(aes(yintercept = log(mean(delay))), colour = "red")
Ciekawą obserwacją jest to, że niektóre przewoźniki, takie jak SKM w Trójmieście, KŚ lub KM mają znaczną część obserwacji z opóźnieniami bliskimi do zera, czyli w pewnym momencie następuje pewny skok tych wartości, wówczas u innych liczba obserwacji z większymi opóźnieniami zmienia się raczej w sposób ciągły bez nagłych skoków. Można zrobić przypuszczenie, że te pierwsze przewoźniki mają albo bardzo niskie, albo raczej wysokie opóźnienie przez to, że na ich działanie mają wpływ w większości przypadków czynniki występujące rzadko, takie jak np wypadki, awaria sieci trakcyjnej lub taboru, wówczas gdy ta druga grupa raczej zależy od częstych i mniej znaczących czynników takich jak np zakłócenia w ruchu lub oczekiwanie na inny pociąg
Kod
most_freq_del = df %>%
group_by(id) %>%
summarise(Delayed = sum(delay>10), carrier = carrier[1], Relacja = paste0(as.character(start[1]), " - ", as.character(end[1]))) %>%
arrange(desc(Delayed))%>%
slice(1:20)
plot_naj = ggplot(most_freq_del, aes(y = reorder(id, -sort(Delayed)), x = Delayed, fill = Delayed, label = Relacja))+
geom_bar(stat = "identity")+
xlab("")+
ylab("")+
ggtitle("Relacje z największą liczbą opóźnionych kursów")+
theme_minimal()+
scale_fill_gradient(low = "lightpink", high = "purple")+
theme(plot.title = element_text(hjust = 0.5, face = "bold"), legend.position = "none", legend.text = element_text(size = 7.5, face = "bold"), legend.title = element_blank(), legend.key.height = unit(1, "line"), legend.key.width = unit(0.3, "line"), legend.margin = margin(), legend.byrow = TRUE)
ggplotly(plot_naj, tooltip = c("label", "fill"))Mapa Polski
Pokażmy jak opóźnienia zależały od tego, skąd przybył pociąg. Do tego celu wziąłem sobie wszystkie unikalne wartości z kolumny start i za pomocą narzędzia ChatGPT otzymałem listę województw w których znajdują się te stacje
Kod
stations = list(
c("Siedlce", "Mazowieckie"),
c("Wejherowo", "Pomorskie"),
c("Warszawa Wschodnia", "Mazowieckie"),
c("Gdańsk Śródmieście", "Pomorskie"),
c("Kraków Główny", "Małopolskie"),
c("Świnoujście", "Zachodniopomorskie"),
c("Kołobrzeg", "Zachodniopomorskie"),
c("Gdańsk Zaspa", "Pomorskie"),
c("Przemyśl Główny", "Podkarpackie"),
c("Gdynia Główna", "Pomorskie"),
c("Jelenia Góra", "Dolnośląskie"),
c("Bohumin", "Śląskie"),
c("Łódź Fabryczna", "Łódzkie"),
c("Radom Główny", "Mazowieckie"),
c("Gdynia Cisowa", "Pomorskie"),
c("Warszawa Zachodnia", "Mazowieckie"),
c("Gdańsk Główny", "Pomorskie"),
c("Mława", "Mazowieckie"),
c("Dęblin", "Lubelskie"),
c("Warszawa Centralna", "Mazowieckie"),
c("Łuków", "Lubelskie"),
c("Szczecin Główny", "Zachodniopomorskie"),
c("Wrocław Główny", "Dolnośląskie"),
c("Żywiec", "Śląskie"),
c("Działdowo", "Warmińsko-Mazurskie"),
c("Skierniewice", "Łódzkie"),
c("Kłodzko Główne", "Dolnośląskie"),
c("Bydgoszcz Główna", "Kujawsko-Pomorskie"),
c("Wodzisław Śląski", "Śląskie"),
c("Konin", "Wielkopolskie"),
c("Częstochowa", "Śląskie"),
c("Ścinawa", "Dolnośląskie"),
c("Choszczno", "Zachodniopomorskie"),
c("Koło", "Wielkopolskie"),
c("Smętowo", "Pomorskie"),
c("Sędziszów", "Świętokrzyskie"),
c("Pruszków", "Mazowieckie"),
c("Gliwice", "Śląskie"),
c("Otwock", "Mazowieckie"),
c("Kłodzko Miasto", "Dolnośląskie"),
c("Gdynia Chylonia", "Pomorskie"),
c("Włocławek", "Kujawsko-Pomorskie"),
c("Skarżysko-Kamienna", "Świętokrzyskie"),
c("Teresin Niepokalanów", "Mazowieckie"),
c("Tłuszcz", "Mazowieckie"),
c("Przeworsk", "Podkarpackie"),
c("Lębork", "Pomorskie"),
c("Kluczbork", "Opolskie"),
c("Katowice", "Śląskie"),
c("Wyrzysk Osiek", "Wielkopolskie"),
c("Racibórz", "Śląskie"),
c("Opole Główne", "Opolskie"),
c("Rzeszów Główny", "Podkarpackie"),
c("Zwardoń", "Śląskie"),
c("Krzyż", "Wielkopolskie"),
c("Stalowa Wola Południe", "Podkarpackie"),
c("Tychy Lodowisko", "Śląskie"),
c("Elbląg", "Warmińsko-Mazurskie"),
c("Legnica", "Dolnośląskie"),
c("Inowrocław", "Kujawsko-Pomorskie"),
c("Żyrardów", "Mazowieckie"),
c("Sulejówek Miłosna", "Mazowieckie"),
c("Bytom", "Śląskie"),
c("Zgorzelec", "Dolnośląskie"),
c("Sochaczew", "Mazowieckie"),
c("Dębica", "Podkarpackie"),
c("Bielsko-Biała Główna", "Śląskie"),
c("Trzebinia", "Małopolskie"),
c("Sieradz", "Łódzkie"),
c("Łowicz Przedmieście", "Łódzkie"),
c("Nowy Bieruń", "Śląskie"),
c("Malbork", "Pomorskie"),
c("Końskie", "Świętokrzyskie"),
c("Radomsko", "Łódzkie"),
c("Warszawa Zachodnia peron 9", "Mazowieckie"),
c("Kościerzyna", "Pomorskie"),
c("Gniezno", "Wielkopolskie"),
c("Kędzierzyn-Koźle", "Opolskie"),
c("Toruń Główny", "Kujawsko-Pomorskie"),
c("Międzylesie", "Dolnośląskie"),
c("Piła Główna", "Wielkopolskie"),
c("Trzebnica", "Dolnośląskie"),
c("Lublin Główny", "Lubelskie"),
c("Płock", "Mazowieckie"),
c("Chojnice", "Pomorskie"),
c("Krynica-Zdrój", "Małopolskie"),
c("Lubliniec", "Śląskie"),
c("Nowogard", "Zachodniopomorskie"),
c("Kłodawa", "Lubuskie"),
c("Mińsk Mazowiecki", "Mazowieckie"),
c("Łowicz Główny", "Łódzkie"),
c("Wołomin Słoneczna", "Mazowieckie"),
c("Piwniczna", "Małopolskie"),
c("Rawicz", "Wielkopolskie"),
c("Jarocin", "Wielkopolskie"),
c("Leszno", "Wielkopolskie"),
c("Ostrowiec Świętokrzyski", "Świętokrzyskie"),
c("Głogów", "Dolnośląskie"),
c("Łęczyca", "Łódzkie"),
c("Zawiercie", "Śląskie"),
c("Jabłonowo Pomorskie", "Kujawsko-Pomorskie"),
c("Grodzisk Mazowiecki", "Mazowieckie"),
c("Słupsk", "Pomorskie"),
c("Chałupki", "Śląskie"),
c("Zagórz", "Podkarpackie"),
c("Grudziądz", "Kujawsko-Pomorskie"),
c("Gorzów Wielkopolski", "Lubuskie"),
c("Łódź Kaliska", "Łódzkie"),
c("Łazy", "Mazowieckie"),
c("Szczecinek", "Zachodniopomorskie"),
c("Modlin", "Mazowieckie"),
c("Mogilno", "Kujawsko-Pomorskie"),
c("Hel", "Pomorskie"),
c("Radzymin", "Mazowieckie"),
c("Ciechanów", "Mazowieckie"),
c("Zbąszynek", "Lubuskie"),
c("Krotoszyn", "Wielkopolskie"),
c("Białystok", "Podlaskie"),
c("Góra Kalwaria", "Mazowieckie"),
c("Kielce", "Świętokrzyskie"),
c("Drzewica", "Łódzkie"),
c("Warszawa Główna", "Mazowieckie"),
c("Piotrków Trybunalski", "Łódzkie"),
c("Koszalin", "Zachodniopomorskie"),
c("Poznań Główny", "Wielkopolskie"),
c("Reda", "Pomorskie"),
c("Kartuzy", "Pomorskie"),
c("Zgierz", "Łódzkie"),
c("Kozłów", "Małopolskie"),
c("Łódź Widzew", "Łódzkie"),
c("Warka", "Mazowieckie"),
c("Sobolew", "Mazowieckie"),
c("Sierpc", "Mazowieckie"),
c("Lubin", "Dolnośląskie"),
c("Laskowice Pomorskie", "Pomorskie"),
c("Kutno", "Łódzkie"),
c("Kamień Pomorski", "Zachodniopomorskie"),
c("Bielawa Zachodnia", "Dolnośląskie"),
c("Celestynów", "Mazowieckie"),
c("Warszawa Lotnisko Chopina", "Mazowieckie"),
c("Olkusz", "Małopolskie"),
c("Włoszczowa", "Świętokrzyskie"),
c("Wągrowiec", "Wielkopolskie"),
c("Skoczów", "Śląskie"),
c("Kwidzyn", "Pomorskie"),
c("Świnoujście Port", "Zachodniopomorskie"),
c("Mrozy", "Mazowieckie"),
c("Warszawa Gdańska", "Mazowieckie"),
c("Tomaszów Mazowiecki", "Łódzkie"),
c("Olsztyn Główny", "Warmińsko-Mazurskie"),
c("Bohumin Vrbice", "Śląskie"),
c("Zgierz Północ", "Łódzkie"),
c("Muszyna", "Małopolskie"),
c("Wałcz", "Zachodniopomorskie"),
c("Gdańsk Wrzeszcz", "Pomorskie"),
c("Rzepin", "Lubuskie"),
c("Ostrów Wielkopolski", "Wielkopolskie"),
c("Strzelin", "Dolnośląskie"),
c("Terespol", "Lubelskie"),
c("Skawina", "Małopolskie"),
c("Kaliska Kujawskie", "Kujawsko-Pomorskie"),
c("Kalisz", "Wielkopolskie"),
c("Ostrołęka", "Mazowieckie"),
c("Pilawa", "Mazowieckie"),
c("Legionowo Piaski", "Mazowieckie"),
c("Lubań Śląski", "Dolnośląskie"),
c("Nasielsk", "Mazowieckie"),
c("Sławków", "Śląskie"),
c("Loecknitz", "Zachodniopomorskie"),
c("Wieliszew", "Mazowieckie"),
c("Zielona Góra Główna", "Lubuskie"),
c("Grodzisk Wielkopolski", "Wielkopolskie"),
c("Piaseczno", "Mazowieckie"),
c("Goleniów", "Zachodniopomorskie"),
c("Jelcz-Laskowice", "Dolnośląskie"),
c("Warszawa Rembertów", "Mazowieckie"),
c("Wierzchucin", "Kujawsko-Pomorskie"),
c("Suwałki", "Podlaskie"),
c("Tuplice", "Lubuskie"),
c("Siechnice", "Dolnośląskie"),
c("Kępno", "Wielkopolskie"),
c("Kąty Wrocławskie", "Dolnośląskie"),
c("Milicz", "Dolnośląskie"),
c("Pruszcz Gdański", "Pomorskie"),
c("Gdynia Stocznia-Uniwersytet Morski", "Pomorskie"),
c("Ełk", "Warmińsko-Mazurskie"),
c("Frankfurt/Oder", "Lubuskie"),
c("Tantow", "Zachodniopomorskie"),
c("Oleśnica", "Dolnośląskie"),
c("Toruń Wschodni", "Kujawsko-Pomorskie"),
c("Czeremcha", "Lubelskie"),
c("Koluszki", "Łódzkie"),
c("Węgliniec", "Dolnośląskie"),
c("Oświęcim", "Małopolskie"),
c("Dąbrowa Górnicza Ząbkowice", "Śląskie"),
c("Tarnów", "Małopolskie"),
c("Czachówek Południowy", "Mazowieckie"),
c("Polanica-Zdrój", "Dolnośląskie"),
c("Przysucha", "Mazowieckie"),
c("Ustka", "Pomorskie"),
c("Lichkov", "Czechy"),
c("Odolanów", "Wielkopolskie"),
c("Iława Główna", "Warmińsko-Mazurskie"),
c("Chełmża", "Kujawsko-Pomorskie"),
c("Sosnowiec Główny", "Śląskie"),
c("Zebrzydowice", "Śląskie"),
c("Szklarska Poręba Górna", "Dolnośląskie"),
c("Błonie", "Mazowieckie"),
c("Miechów", "Małopolskie"),
c("Nakło nad Notecią", "Kujawsko-Pomorskie"),
c("Rogoźno Wielkopolskie", "Wielkopolskie"),
c("Orzesze", "Śląskie"),
c("Tarnowskie Góry", "Śląskie"),
c("Kudowa-Zdrój", "Dolnośląskie"),
c("Kolbuszowa", "Podkarpackie"),
c("Kostrzyn", "Lubuskie"),
c("Tczew", "Pomorskie"),
c("Września", "Wielkopolskie"),
c("Legionowo", "Mazowieckie"),
c("Chełm", "Lubelskie"),
c("Namysłów", "Opolskie"),
c("Ziębice", "Dolnośląskie"),
c("Kościan", "Wielkopolskie"),
c("Busko-Zdrój", "Świętokrzyskie"),
c("Pabianice", "Łódzkie"),
c("Stargard", "Zachodniopomorskie"),
c("Chojna", "Zachodniopomorskie"),
c("Starczów", "Dolnośląskie"),
c("Luzino", "Pomorskie"),
c("Wołów", "Dolnośląskie"),
c("Medyka", "Podkarpackie"),
c("Kamieniec Ząbkowicki", "Dolnośląskie"),
c("Giżycko", "Warmińsko-Mazurskie"),
c("Gryfino", "Zachodniopomorskie"),
c("Wałbrzych Miasto", "Dolnośląskie"),
c("Pszczyna", "Śląskie"),
c("Brzeg", "Dolnośląskie"),
c("Nysa", "Opolskie"),
c("Opoczno", "Łódzkie"),
c("Horyniec-Zdrój", "Lubelskie"),
c("Pionki", "Mazowieckie"),
c("Gołańcz", "Wielkopolskie"),
c("Władysławowo", "Pomorskie"),
c("Małkinia", "Mazowieckie"),
c("Wałbrzych Główny", "Dolnośląskie"),
c("Gdańsk Rębiechowo", "Pomorskie"),
c("Pierściec", "Śląskie"),
c("Kalisz Pomorski", "Zachodniopomorskie"),
c("Piechowice", "Dolnośląskie"),
c("Łódź Olechów Łoc", "Łódzkie"),
c("Piasecznica", "Mazowieckie"),
c("Świebodzin", "Lubuskie"),
c("Malczyce", "Dolnośląskie"),
c("Czempiń", "Wielkopolskie"),
c("Łódź Chojny", "Łódzkie"),
c("Warszawa Falenica", "Mazowieckie"),
c("Forst Lausitz", "Niemcy"),
c("Czechowice-Dziedzice", "Śląskie"),
c("Grzmiąca", "Zachodniopomorskie"),
c("Mezimesti", "Czechy"),
c("Jagodin", "Serbia"),
c("Bierutów", "Dolnośląskie"),
c("Sucha Beskidzka", "Małopolskie"),
c("Tychowo", "Zachodniopomorskie"),
c("Białogard", "Zachodniopomorskie"),
c("Nowy Sącz", "Małopolskie"),
c("Wrocław Stadion", "Dolnośląskie"),
c("Gdańsk Osowa", "Pomorskie"),
c("Dorohusk", "Lubelskie"),
c("Opole Wschodnie", "Opolskie"),
c("Czersk", "Pomorskie"),
c("Gągławki", "Pomorskie"),
c("Warszawa Gocławek", "Mazowieckie"),
c("Cieszyn", "Śląskie"),
c("Bednary", "Wielkopolskie"),
c("Bystrzyca Kłodzka Przedmieście", "Dolnośląskie"),
c("Raszówka", "Dolnośląskie"),
c("Zator", "Małopolskie"),
c("Warszawa Wawer", "Mazowieckie"),
c("Prostynia", "Warmińsko-Mazurskie"),
c("Małdyty", "Warmińsko-Mazurskie"),
c("Jeleśnia", "Małopolskie")
)
wojew = do.call(rbind, lapply(stations, function(x) data.frame(start = x[[1]], region = x[[2]])))
dfwoj = merge(x = df, y = wojew, by = "start")
rm(wojew)Po łączeniu tej listy z naszą wyjściową ramką danych wybieramy sobie kilka cech które chcemy zwizualizować
Kod
leaderinwoj = dfwoj %>%
group_by(region, carrier)%>%
summarise(avg = mean(delay)) %>%
slice(which.max(avg))
bigbywoj = dfwoj %>%
group_by(region) %>%
summarise(more_by_10 = 100*sum(delay>5)/n())
lublin_dir = dfwoj[df$end == "Lublin Główny",] %>%
group_by(region)%>%
summarise(delaysum = sum(delay))Kod
library(rgeoboundaries)
poland_void = gb_adm1("Poland")
voiv = c("Podkarpackie", "Podlaskie", "Łódzkie", "Dolnośląskie", "Opolskie", "Świętokrzyskie",
"Mazowieckie", "Wielkopolskie", "Małopolskie", "Lubuskie", "Kujawsko-Pomorskie",
"Pomorskie", "Zachodniopomorskie", "Lubelskie", "Warmińsko-Mazurskie", "Śląskie")
poland_void$shapeName = voiv
bigbywoj_map = merge(poland_void, bigbywoj, by.x = "shapeName", by.y = "region")
bigbywoj_map %>%
ggplot(aes(fill=more_by_10)) +
geom_sf(show.legend = c(alpha=F), color = "white") +
scale_fill_gradient(low = "lightgreen", high = "darkgreen") +
labs(fill="%") +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5, face = "bold"))+
ggtitle("Odsetek opóźnień większych od 10 min")
Widzimy, że najwięcej istotnych opóźnień pojawia się w relacjach które przybywają z województw granicznych naszego kraju. Ma to sens, gdyż pociągi te mogą czekać na często spóźnione pociągi jadące zza granicy z takich krajów, jak Niemcy, Czechy czy Ukraina
Kod
leaderinwoj_map = merge(poland_void, leaderinwoj, by.x = "shapeName", by.y = "region")
leaderinwoj_map %>%
ggplot(aes(fill=carrier)) +
geom_sf(show.legend = c(alpha=F), color = "white") +
labs(fill="") +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5, face = "bold"))+
ggtitle("Przewoźnik z największą średnią opóźnień")
Okazało się, że PKP IC jest leaderem w każdym wojewodztwie oprócz Świętokrzyskiego, w tym ostatnim z kolei najbardziej się spóźniały Koleje Mazowieckie. Może to być spowodowane tym, że PKP IC jest największym przewoźnikiem kolejowym w Polsce, jego relacje są dłuższe a więc bardziej są poddane czynnikom sprzyjającym opóźnieniom
Kod
lublin_dir_map = merge(poland_void, lublin_dir, by.x = "shapeName", by.y = "region")
lublin_dir_map %>%
ggplot(aes(fill=delaysum))+
geom_sf(show.legend = c(alpha=F), color = "black") +
labs(fill="min") +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5, face = "bold"))+
scale_fill_gradient(low = "lightblue", high = "darkblue") +
ggtitle("Skąd najwięcej spóźnień do Lublina")
Wnioski
Wnioski z przeprowadzonej analizy wskazują, że choć początkowo zakładałem istnienie wyraźnej zależności pomiędzy opóźnieniami pociągów a warunkami pogodowymi, wyniki analizy korelacji nie ujawniają istotnej zależności pomiędzy tymi zmiennymi. Korelacja pomiędzy opóźnieniami a zmiennymi meteorologicznymi, okazała się bliska zeru. Oznacza to, że warunki pogodowe nie są głównym czynnikiem wpływającym na opóźnienia pociągów w tym okresie. Z kolei wizualizacje ujawniły ciekawe zależności, które da się wyjaśnić już po zaobserwowaniu a których nie oczekiwałem początkowo znaleźć, takich jak na przykład zwiększone opóźnienia u pociągów z granicznych regionów oraz rozkład opóźnień u poszczególnych przewoźników